home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / tests / window.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  4.0 KB  |  132 lines  |  [TEXT/ALFA]
  1. # This file is a Tcl script to test the procedures in the file
  2. # tkWindow.c.  It is organized in the standard fashion for Tcl tests.
  3. #
  4. # Copyright (c) 1995 Sun Microsystems, Inc.
  5. #
  6. # See the file "license.terms" for information on usage and redistribution
  7. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  8. #
  9. # SCCS: @(#) window.test 1.8 97/01/22 14:17:54
  10.  
  11. if {[info procs test] != "test"} {
  12.     source defs
  13. }
  14.  
  15. foreach i [winfo children .] {
  16.     destroy $i
  17. }
  18. wm geometry . {}
  19. raise .
  20. update
  21.  
  22. # XXX This file is woefully incomplete.  Right now it only tests
  23. # a few parts of a few procedures in tkWindow.c
  24.  
  25. test window-1.1 {Tk_CreateWindowFromPath procedure, parent dead} {
  26.     proc bgerror msg {
  27.     global x errorInfo
  28.     set x [list $msg $errorInfo]
  29.     }
  30.     set x unchanged
  31.     catch {destroy .t}
  32.     frame .t -width 100 -height 50
  33.     place .t -x 10 -y 10
  34.     bind .t <Destroy> {button .t.b -text hello; pack .t.b}
  35.     update
  36.     destroy .t
  37.     update
  38.     rename bgerror {}
  39.     set x
  40. } {{can't create window: parent has been destroyed} {can't create window: parent has been destroyed
  41.     while executing
  42. "button .t.b -text hello"
  43.     (command bound to event)}}
  44.  
  45. # Most of the tests below don't produce meaningful results;  they
  46. # will simply dump core if there are bugs.
  47.  
  48. test window-2.1 {Tk_DestroyWindow procedure, destroy handler deletes parent} {
  49.     toplevel .t -width 300 -height 200
  50.     wm geometry .t +0+0
  51.     frame .t.f  -width 200 -height 200 -relief raised -bd 2
  52.     place .t.f -x 0 -y 0
  53.     frame .t.f.f -width 100 -height 100 -relief raised -bd 2
  54.     place .t.f.f -relx 1 -rely 1 -anchor se
  55.     bind .t.f <Destroy> {destroy .t}
  56.     update
  57.     destroy .t.f
  58. } {}
  59. test window-2.2 {Tk_DestroyWindow procedure, destroy handler deletes parent} {
  60.     toplevel .t -width 300 -height 200
  61.     wm geometry .t +0+0
  62.     frame .t.f  -width 200 -height 200 -relief raised -bd 2
  63.     place .t.f -x 0 -y 0
  64.     frame .t.f.f -width 100 -height 100 -relief raised -bd 2
  65.     place .t.f.f -relx 1 -rely 1 -anchor se
  66.     bind .t.f.f <Destroy> {destroy .t}
  67.     update
  68.     destroy .t.f
  69. } {}
  70. test window-2.3 {Tk_DestroyWindow procedure, destroy handler deletes parent} {
  71.     frame .f -width 80 -height 120 -relief raised -bd 2
  72.     place .f -relx 0.5 -rely 0.5 -anchor center
  73.     toplevel .f.t -width 300 -height 200
  74.     wm geometry .f.t +0+0
  75.     frame .f.t.f  -width 200 -height 200 -relief raised -bd 2
  76.     place .f.t.f -x 0 -y 0
  77.     frame .f.t.f.f -width 100 -height 100 -relief raised -bd 2
  78.     place .f.t.f.f -relx 1 -rely 1 -anchor se
  79.     update
  80.     destroy .f
  81. } {}
  82.  
  83. test window-3.1 {Tk_MakeWindowExist procedure, stacking order and menubars} unixOnly {
  84.     catch {destroy .t}
  85.     toplevel .t -width 300 -height 200
  86.     wm geometry .t +0+0
  87.     pack [entry .t.e]
  88.     frame .t.f -bd 2 -relief raised
  89.     testmenubar window .t .t.f
  90.     update
  91.     # If stacking order isn't handle properly, generates an X error.
  92. } {}
  93. test window-3.2 {Tk_MakeWindowExist procedure, stacking order and menubars} unixOnly {
  94.     catch {destroy .t}
  95.     toplevel .t -width 300 -height 200
  96.     wm geometry .t +0+0
  97.     pack [entry .t.e]
  98.     pack [entry .t.e2]
  99.     update
  100.     frame .t.f -bd 2 -relief raised
  101.     raise .t.f .t.e
  102.     testmenubar window .t .t.f
  103.     update
  104.     # If stacking order isn't handled properly, generates an X error.
  105. } {}
  106.  
  107. test window-4.1 {Tk_NameToWindow procedure} {
  108.     catch {destroy .t}
  109.     list [catch {winfo geometry .t} msg] $msg
  110. } {1 {bad window path name ".t"}}
  111. test window-4.2 {Tk_NameToWindow procedure} {
  112.     catch {destroy .t}
  113.     frame .t -width 100 -height 50
  114.     place .t -x 10 -y 10
  115.     update
  116.     list [catch {winfo geometry .t} msg] $msg
  117. } {0 100x50+10+10}
  118.  
  119. test window-5.1 {Tk_MakeWindowExist procedure, stacking order and menubars} unixOnly {
  120.     catch {destroy .t}
  121.     toplevel .t -width 300 -height 200
  122.     wm geometry .t +0+0
  123.     pack [entry .t.e]
  124.     pack [entry .t.e2]
  125.     frame .t.f -bd 2 -relief raised
  126.     testmenubar window .t .t.f
  127.     update
  128.     lower .t.e2 .t.f
  129.     update
  130.     # If stacking order isn't handled properly, generates an X error.
  131. } {}
  132.